home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / novtli / novtli.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  17.6 KB  |  562 lines
  1. unit Novtli;
  2. { Install this component using Options|Install Compenents.
  3.   The function of this module is to provide Delphi with a
  4.   component capable of interfacing with Novell's Transport
  5.   Layer Interface (TLI) providing IPX/SPX transport capabilities.
  6.  
  7.   You must have a network card installed and the appropriate Netware
  8.   drivers to use this component. For example. An 3Com Ethernet card with
  9.   the 3c509 driver, lsl, ipxodi, nwipxspx.dll, tli_spx.dll, and tli_win.dll.
  10.  
  11.   The code herein is released to the public domain under the condition
  12.   that it will not be used for commercial or "For Profit" ventures.
  13.  
  14.   Written By:      Gary T. Desrosiers
  15.   Date:            May 25th, 1995.
  16.   Copyright:       (R) Copyright by Gary T. Desrosiers, 1995. All Rights Reserved
  17.   UserID(s):       71062,2754
  18.                    desrosi@pcnet.com
  19.  
  20.   Description:     Novell Transport Layer Interface (TLI) Component.
  21.  
  22.   Properties:      ServerName, Design time and runtime read/write.
  23.                      (This option is mutually exclusive with 'Addr').
  24.                      For servers, sets the name that the server will
  25.                      be advertised as.
  26.                      For clients, sets the name of the server to connect to.
  27.                      This option causes a Service Advertising Protocol (SAP)
  28.                      request to be issued on the network. You're network
  29.                      must be capable of supporting SAP for ServerName to
  30.                      be used. A Netware server or router/bridge capable of
  31.                      servicing the QueryServices request must be present.
  32.  
  33.                      example;
  34.                        NovTLI1.ServerName := 'MyServer';
  35.  
  36.                    Addr, Design time and runtime read/write.
  37.                      (This property is mutually exclusive with 'ServerName')
  38.                      Sets the physical network and node address' of
  39.                      the server that this client will connect to.
  40.                      The format of the address is:
  41.                                 xxxxxxxx/yyyyyyyyyyyy
  42.                      where x is the hexadecimal network number and y is
  43.                      the hexadecimal node number. Both addresses can be
  44.                      obtained using the Netware command:
  45.                                 userlist /a
  46.                      The network is defined by the Netware server and
  47.                      the Node is defined as the MAC address of the
  48.                      network card.
  49.                      For example, if the server was running on my PC
  50.                      where the network = 00000001 and the node =
  51.                      0080C72E12D4, I would do the following:
  52.                        NovTLI1.Addr := '00000001/0080C72E12D4';
  53.  
  54.                    Port, Design time and runtime read/write.
  55.                      Client: port number that this client connects
  56.                        to on the server. If you're using 'ServerName'
  57.                        the client doesnt have to set this property. It
  58.                        will be determined dynamically using SAP. (See
  59.                        description under 'ServerName' property).
  60.                      Server: sets the port number that this server will
  61.                        listen on. You must always specify this for servers.
  62.                        You can use any unique number you like.
  63.                      example;
  64.                        NovTLI1.Port := 31;
  65.  
  66.                    Text, Runtime read/write.
  67.                      if set, sends the text to the partner.
  68.                      if read, receives some text from the partner.
  69.                      examples;
  70.                        buffer := NovTLI1.Text; (* Receive data *)
  71.                        NovTLI1.Text := 'This is a test'; (* Send Data *)
  72.  
  73.                    SocketNumber, Runtime read/write.
  74.                      Unique number representing the client connection
  75.                      This is set by the component after a connect call
  76.                      and also after a server has issued a Accept;
  77.  
  78.                    ListenSocketNumber, Runtime read/write.
  79.                      Unique number representing the server's connection.
  80.                      This is set by the component after a Listen;
  81.  
  82. Methods:           Connect - Connects to the remote (or local) system
  83.                      specified in the Addr and Port properties or to the
  84.                      server specified in 'ServerName'.
  85.  
  86.                      example;
  87.                        NovTLI1.Connect; (* Connect to partner *)
  88.  
  89.                    Listen - Listens on the port specified in the Port
  90.                      property. Optionally advertise the 'ServerName' so
  91.                      that clients can connect using name rather than
  92.                      physical address.
  93.  
  94.                      example;
  95.                        Sockets1.Listen; (* Establish server environment *)
  96.  
  97.                    Accept - Accepts a client request. Usually issued in
  98.                      OnSessionAvailable event.
  99.                      example;
  100.                        Sock := NovTLI1.Accept; (* Get client connection *)
  101.  
  102.                    Close - Closes the connection.
  103.                      example;
  104.                        NovTLI1.Close; (* Close connection *)
  105.  
  106.                    Disconnect - Sends disconnect to partner
  107.                      example;
  108.                        NovTLI1.Disconnect;
  109.  
  110. Events:            OnDataAvailable - Called when data is available to
  111.                      be received from the partner. You should issue;
  112.                      buffer := NovTLI1.Text; to receive the data from
  113.                      the partner.
  114.  
  115.                    OnSessionAvailable - Called when a client has requested
  116.                      to connect to a 'listening' server. You can call
  117.                      the method Accept here.
  118.  
  119.                    OnSessionClosed - Called when the partner has closed
  120.                      a connection on you. Normally, you would close your side
  121.                      of the connection when this event happens.
  122.  
  123.                    OnSessionConnected - Called when the Connect has
  124.                      completed and the session is connected. This is a
  125.                      good place to send the initial data of a conversation.
  126.                      Also, you may want to enable certain controls that
  127.                      allow the user to send data on the conversation here.
  128. }
  129.  
  130. interface
  131.  
  132. uses
  133.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  134.   Forms, Dialogs, nwsap, nxtw, tiuser, tispxipx;
  135.  
  136. const
  137.   TLI_TYPE = $9000;
  138.  
  139. type
  140.   TDataAvailable = procedure (Sender: TObject; Socket: integer) of object;
  141.   TSessionClosed = procedure (Sender: TObject; Socket: integer) of object;
  142.   TSessionAvailable = procedure (Sender: TObject; Socket: integer) of object;
  143.   TSessionConnected = procedure (Sender: TObject; Socket: integer) of object;
  144.   TNovTLI = class(TWinControl)
  145.   private
  146.     FPort: integer;
  147.     FServerName: string;
  148.     FAddr: string;
  149.     FSocket: integer;
  150.     FLSocket: integer;
  151.     FTimer: integer;
  152.     spx_addr: IPX_ADDR;
  153.     spx_options: SPX_OPTS;
  154.     tbind: t_bindREC;
  155.     tcall: t_callREC;
  156.     discon: t_disconREC;
  157.     sap: SAP;
  158.     FDataAvailable: TDataAvailable;
  159.     FSessionClosed: TSessionClosed;
  160.     FSessionAvailable: TSessionAvailable;
  161.     FSessionConnected: TSessionConnected;
  162.     procedure SetText(Text: string);
  163.     function GetText : string;
  164.     procedure TWMPaint(var msg:TWMPaint); message WM_PAINT;
  165.     procedure TWMTimer(var msg:TWMTimer); message WM_TIMER;
  166.     function PutAddress(str: PChar; buf: PChar; hexBytes: integer) : integer;
  167.     function ParseAddress(addr: PChar; var destination: IPX_ADDR) : integer;
  168.   protected
  169.     { Protected declarations }
  170.   public
  171.     constructor Create(AOwner: TComponent); override;
  172.     destructor Destroy; override;
  173.     procedure Connect;
  174.     procedure Close;
  175.     procedure Listen;
  176.     procedure Disconnect;
  177.     procedure Accept;
  178.     property SocketNumber: integer read FSocket write FSocket;
  179.     property ListenSocketNumber: integer read FLSocket write FLSocket;
  180.     property Text: string read GetText write SetText;
  181.   published
  182.     property ServerName: string read FServerName write FServerName;
  183.     property Addr: string read FAddr write FAddr;
  184.     property Port: integer read FPort write FPort;
  185.     property OnDataAvailable: TDataAvailable read FDataAvailable
  186.       write FDataAvailable;
  187.     property OnSessionClosed: TSessionClosed read FSessionClosed
  188.       write FSessionClosed;
  189.     property OnSessionAvailable: TSessionAvailable read FSessionAvailable
  190.       write FSessionAvailable;
  191.     property OnSessionConnected: TSessionConnected read FSessionConnected
  192.       write FSessionConnected;
  193.   end;
  194.  
  195. procedure Register;
  196.  
  197. implementation
  198.  
  199. procedure Register;
  200. begin
  201.   RegisterComponents('Samples', [TNovTLI]);
  202. end;
  203.  
  204. constructor TNovtli.Create(AOwner: TComponent);
  205. var
  206.   iStatus: integer;
  207. begin
  208.   inherited Create(AOwner);
  209.   FPort := 0;
  210.   FServerName := '';
  211.   FAddr := '';
  212.   FSocket := -1;
  213.   FLSocket := -1;
  214.   FTimer := 0;
  215.   Text := '';
  216.   Invalidate;
  217. end;
  218.  
  219. destructor TNovtli.Destroy;
  220. begin
  221.   if FSocket = -1 then
  222.   begin
  223.     t_close(FSocket);
  224.     FSocket := -1;
  225.   end;
  226.   if FLSocket = -1 then
  227.   begin
  228.     t_close(FLSocket);
  229.     FLSocket := -1;
  230.   end;
  231.   inherited Destroy;
  232. end;
  233.  
  234. procedure TNovtli.TWMTimer(var msg: TWMTimer);
  235. var
  236.   LookEvent: integer;
  237. begin
  238.   if msg.TimerID = 100 then
  239.   begin
  240.     if (FSocket = -1) and (FLSocket = -1) then
  241.       exit;
  242.     if FSocket <> -1 then
  243.     begin
  244.       LookEvent := t_look(FSocket);
  245.       case LookEvent of
  246.         C_T_DATA:
  247.         begin
  248.           FDataAvailable(Self,FSocket);
  249.         end;
  250.         C_T_LISTEN:
  251.         begin
  252.           if t_listen(FSocket,@tcall) = -1 then
  253.           begin
  254.             t_close(FSocket);
  255.             t_error('Poll: t_listen failed');
  256.             exit;
  257.           end;
  258.           FSessionAvailable(Self,FSocket);
  259.         end;
  260.         C_T_DISCONNECT:
  261.         begin
  262.           if t_rcvdis(FSocket,nil) = -1 then
  263.           begin
  264.         t_close(FSocket);
  265.             t_error('Poll: t_rcvdis failed');
  266.             exit;
  267.           end;
  268.           FSessionClosed(Self,FSocket);
  269.         end;
  270.         C_T_CONNECT:
  271.         begin
  272.           if t_rcvconnect(FSocket,@tcall) = -1 then
  273.           begin
  274.             t_close(FSocket);
  275.             t_error('Poll: t_rcvconnect failed');
  276.           end;
  277.           FSessionConnected(Self,FSocket);
  278.         end;
  279.       end;
  280.     end;
  281.  
  282.     if FLSocket <> -1 then
  283.     begin
  284.       LookEvent := t_look(FLSocket);
  285.       case LookEvent of
  286.         C_T_DATA:
  287.         begin
  288.           FDataAvailable(Self,FLSocket);
  289.         end;
  290.         C_T_LISTEN:
  291.         begin
  292.           if t_listen(FLSocket,@tcall) = -1 then
  293.           begin
  294.         t_close(FLSocket);
  295.         t_error('Poll: t_listen failed');
  296.             exit;
  297.       end;
  298.           FSessionAvailable(Self,FLSocket);
  299.         end;
  300.         C_T_DISCONNECT:
  301.         begin
  302.           if t_rcvdis(FLSocket,nil) = -1 then
  303.           begin
  304.             t_close(FLSocket);
  305.             t_error('Poll: t_rcvdis failed');
  306.             exit;
  307.           end;
  308.           FSessionClosed(Self,FLSocket);
  309.         end;
  310.         C_T_CONNECT:
  311.         begin
  312.           if t_rcvconnect(FLSocket,@tcall) = -1 then
  313.           begin
  314.         t_close(FLSocket);
  315.             t_error('Poll: t_rcvconnect failed');
  316.         exit;
  317.           end;
  318.           FSessionConnected(Self,FLSocket);
  319.         end;
  320.       end;
  321.     end;
  322.   end;
  323. end;
  324.  
  325. procedure TNovtli.TWMPaint(var msg: TWMPaint);
  326. var
  327.   icon: HIcon;
  328.   dc: HDC;
  329. begin
  330.   if csDesigning in ComponentState then
  331.   begin
  332.     icon := LoadIcon(HInstance,MAKEINTRESOURCE('TNOVTLI'));
  333.     dc := GetDC(Handle);
  334.     Width := 32;
  335.     Height := 32;
  336.     DrawIcon(dc,0,0,icon);
  337.     ReleaseDC(Handle,dc);
  338.     FreeResource(icon);
  339.   end;
  340.   ValidateRect(Handle,nil);
  341. end;
  342.  
  343. function TNovtli.PutAddress(str: PChar; buf: PChar; hexBytes: integer) : integer;
  344. var
  345.   i,j,n,value: integer;
  346.   c: char;
  347. begin
  348.   StrUpper(str);
  349.   n := 0;
  350.   for i:=0 to hexBytes-1 do
  351.   begin
  352.     value := 0;
  353.     for j:=0 to 1 do
  354.     begin
  355.       value := value shl 4;
  356.       if (str[n] >= '0') and (str[n] <= '9') then
  357.         value := value + ord(str[n]) - $30;
  358.       if (str[n] >= 'A') and (str[n] <= 'F') then
  359.         value := value + ord(str[n]) - $41 + 10;
  360.       inc(n);
  361.     end;
  362.   buf[i] := chr(value);
  363.   end;
  364.   PutAddress := 1;
  365. end;
  366.  
  367. function TNovtli.ParseAddress(addr: PChar; var destination: IPX_ADDR) : integer;
  368. begin
  369.   ParseAddress := 0;
  370.   if (StrLen(addr) = 21) and (addr[8] = '/') then
  371.   begin
  372.     if PutAddress(addr,destination.ipxa_net,4) = 1 then
  373.       if PutAddress(@addr[9],destination.ipxa_node,6) = 1 then
  374.         ParseAddress := 1;
  375.   end;
  376. end;
  377.  
  378. procedure TNovtli.Connect;
  379. var
  380.   ServerName: array[0..47] of char;
  381.   szAddr: array[0..25] of char;
  382.   i: integer;
  383. begin
  384.   if FTimer = 0 then
  385.     FTimer := SetTimer(Handle,100,125,nil);
  386.   if FServerName <> '' then
  387.   begin
  388.     StrPCopy(ServerName,FServerName);
  389.     repeat
  390.       if QueryServices(1,TLI_TYPE,sizeof(SAP),sap) <> 0 then
  391.         break;
  392.     until ServerName = sap.ServerName;
  393.     if StrComp(ServerName,sap.ServerName) = 0 then
  394.     begin
  395.       spx_addr.ipxa_socket[0] := sap.Socket[0];
  396.       spx_addr.ipxa_socket[1] := sap.Socket[1];
  397.       for i:=0 to 3 do
  398.         spx_addr.ipxa_net[i] := sap.Network[i];
  399.       for  i:=0 to 5 do
  400.         spx_addr.ipxa_node[i] := sap.Node[i];
  401.     end;
  402.   end
  403.   else
  404.   begin
  405.     strPCopy(szAddr,FAddr);
  406.     ParseAddress(szAddr,spx_addr);
  407.     spx_addr.ipxa_socket[0] := chr(FPort shr 8);
  408.     spx_addr.ipxa_socket[1] := chr(FPort and $ff);
  409.   end;
  410.   FSocket := t_open('/dev/nspx',O_RDWR or O_NDELAY, nil);
  411.   if FSocket = -1 then
  412.     t_error('Connect: t_open failed');
  413.   if t_bind(FSocket,nil,nil) = -1 then
  414.     t_error('Connect: t_bind failed');
  415.   tcall.addr.buf := @spx_addr;
  416.   tcall.addr.len := sizeof(spx_addr);
  417.   tcall.addr.maxlen := sizeof(spx_addr);
  418.   spx_options.spx_connectionID[0] := #0;
  419.   spx_options.spx_connectionID[1] := #0;
  420.   spx_options.spx_allocationNumber[0] := #0;
  421.   spx_options.spx_allocationNumber[1] := #0;
  422.   tcall.opt.buf := @spx_options;
  423.   tcall.opt.len := sizeof(spx_options);
  424.   tcall.opt.maxlen := sizeof(spx_options);
  425.   tcall.udata.buf := nil;
  426.   tcall.udata.len := 0;
  427.   tcall.udata.maxlen := 0;
  428.   t_connect(FSocket,@tcall,@tcall);
  429. end;
  430.  
  431. procedure TNovtli.Accept;
  432. begin
  433.   if FLSocket = -1 then
  434.   begin
  435.     Application.MessageBox('Accept: No open socket','NovTLI',MB_ICONEXCLAMATION);
  436.     exit;
  437.   end;
  438.   FSocket := t_open('/dev/nspx',O_RDWR or O_NDELAY,nil);
  439.   if FSocket = -1 then
  440.     t_error('Accept: t_open failed');
  441.   if t_bind(FSocket,nil,nil) = -1 then
  442.   begin
  443.     t_error('Accept: t_bind failed');
  444.     t_close(FSocket);
  445.     FSocket := -1;
  446.   end;
  447.   if t_accept(FLSocket,FSocket,@tcall) = -1 then
  448.   begin
  449.     t_error('Accept: t_accept failed');
  450.     t_close(FLSocket);
  451.     FSocket := -1;
  452.   end;
  453. end;
  454.  
  455. procedure TNovtli.Close;
  456. var
  457.   szServerName: array[0..31] of char;
  458. begin
  459.   if FSocket <> -1 then
  460.   begin
  461.     t_close(FSocket);
  462.     if FSocket = FLSocket then
  463.       FLSocket := -1;
  464.     if FServerName <> '' then
  465.     begin
  466.       StrPCopy(szServerName,FServerName);
  467.       ShutdownSAP(szServerName);
  468.     end;
  469.     FSocket := -1;
  470.   end;
  471.   if (FSocket = -1) and (FLSocket = -1) then
  472.     if FTimer <> 0 then
  473.     begin
  474.       KillTimer(Handle,FTimer);
  475.       FTimer := -1;
  476.     end;
  477. end;
  478.  
  479. procedure TNovtli.Disconnect;
  480. begin
  481.   if FSocket <> -1 then
  482.     if t_snddis(FSocket,@tcall) = -1 then
  483.       t_error('Disconnect: t_snddis failed');
  484. end;
  485.  
  486. procedure TNovtli.SetText(Text: string);
  487. var
  488.   buf: array[0..256] of char;
  489. begin
  490.   StrPCopy(buf,Text);
  491.   if not(csDesigning in ComponentState) and (FSocket <> -1) then
  492.   begin
  493.     if t_snd(FSocket,buf,length(Text),0) = -1 then
  494.     begin
  495.       t_error('Text (Set): t_snd failed');
  496.       t_close(FSocket);
  497.       FSocket := -1;
  498.     end;
  499.   end;
  500. end;
  501.  
  502. procedure TNovtli.Listen;
  503. var
  504.   szServerName: array[0..31] of char;
  505. begin
  506.   if FTimer = 0 then
  507.     FTimer := SetTimer(Handle,100,125,nil);
  508.   if FPort = 0 then
  509.     Application.MessageBox('Port not specified, cannot listen','NovTLI',MB_ICONEXCLAMATION);
  510.   FLSocket := t_open('/dev/nspx',O_RDWR or O_NDELAY, nil);
  511.   if FLSocket = -1 then
  512.     t_error('Connect: t_open failed');
  513.   spx_addr.ipxa_socket[0] := chr(FPort shr 8);
  514.   spx_addr.ipxa_socket[1] := chr(FPort and $ff);
  515.   tbind.addr.len := sizeof(spx_addr);
  516.   tbind.addr.maxlen := sizeof(spx_addr);
  517.   tbind.addr.buf := @spx_addr;
  518.   tbind.qlen := 5;
  519.   if t_bind(FLSocket,@tbind,@tbind) = -1 then
  520.     t_error('Listen: t_bind failed');
  521.   tcall.addr.buf := @spx_addr;
  522.   tcall.addr.len := sizeof(spx_addr);
  523.   tcall.addr.maxlen := sizeof(spx_addr);
  524.   spx_options.spx_connectionID[0] := #0;
  525.   spx_options.spx_connectionID[1] := #0;
  526.   spx_options.spx_allocationNumber[0] := #0;
  527.   spx_options.spx_allocationNumber[1] := #0;
  528.   tcall.opt.buf := @spx_options;
  529.   tcall.opt.len := sizeof(spx_options);
  530.   tcall.opt.maxlen := sizeof(spx_options);
  531.   tcall.udata.buf := nil;
  532.   tcall.udata.len := 0;
  533.   tcall.udata.maxlen := 0;
  534.   if FServerName <> '' then
  535.   begin
  536.     StrPCopy(szServerName,FServerName);
  537.     AdvertiseService(TLI_TYPE,szServerName,FPort);
  538.   end;
  539. end;
  540.  
  541. function TNovtli.GetText: string;
  542. var
  543.   flags: integer;
  544.   buf: array[0..256] of char;
  545.   len: integer;
  546. begin
  547.   flags := 0;
  548.   if FSocket <> -1 then
  549.   begin
  550.     if not(csDesigning in ComponentState) then
  551.     begin
  552.       len := t_rcv(FSocket,buf,sizeof(buf)-1,flags);
  553.       if len < 0 then
  554.         t_error('Text (Get): t_rcv failed');
  555.       buf[len] := #0;
  556.       GetText := StrPas(buf);
  557.     end;
  558.   end;
  559. end;
  560.  
  561. end.
  562.